home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #2 / Monster Media No. 2 (Monster Media)(1994).ISO / prog_pas / sk210f.zip / SHCRCCHK.PAS < prev    next >
Pascal/Delphi Source File  |  1994-05-11  |  8KB  |  225 lines
  1. {$I SHDEFINE.INC}
  2.  
  3. {$I SHUNITSW.INC}
  4.  
  5. {$D-,L-}
  6. {$A-}
  7. unit ShCrcChk;
  8. {
  9.                                 ShCrcChk
  10.  
  11.                      A File CRC16 Calculation Unit
  12.  
  13.                                    by
  14.  
  15.                               Bill Madison
  16.  
  17.                    W. G. Madison and Associates, Ltd.
  18.                           13819 Shavano Downs
  19.                             P.O. Box 780956
  20.                        San Antonio, TX 78278-0956
  21.                              (512)492-2777
  22.                              CIS 73240,342
  23.                 Internet bill.madison@lchance.sat.tx.us
  24.  
  25.                 Copyright 1990, '94 Madison & Associates
  26.                           All Rights Reserved
  27.  
  28.         This file may  be used and distributed  only in accord-
  29.         ance with the provisions described on the title page of
  30.                   the accompanying documentation file
  31.                               SKYHAWK.DOC
  32. }
  33.  
  34. Interface
  35.  
  36. Uses
  37.   DOS;
  38.  
  39. const
  40.   Copyr = 'Copyright 1990, 1994 by W.G. Madison';
  41.  
  42. Function CrcCalc(FileName : String) : word;
  43. {
  44.       Calculates the CCITT asynch CRC16 value for file = FileName.
  45. }
  46.  
  47. Function CrcCopy(InFileName, OutFileName : String) : word;
  48. {
  49.       Calculates the CCITT asynch CRC16 value for file=InFileName. If
  50. OutFileName is specified, InFileName is copied to OutFileName. In either
  51. case, the CRC16 value is returned.
  52. }
  53.  
  54. Implementation
  55.  
  56. const
  57.   BuffSize  = $F000;
  58.  
  59. type
  60.   BuffType  = array[1..BuffSize] of Byte;
  61.  
  62. var
  63.     Buff   :  ^BuffType;   {The data buffer}
  64.  
  65. const
  66.   CrcTab : array[0..255] of Word =
  67.     ($0000,$1021,$2042,$3063,$4084,$50A5,$60C6,$70E7,
  68.      $8108,$9129,$A14A,$B16B,$C18C,$D1AD,$E1CE,$F1EF,
  69.      $1231,$0210,$3273,$2252,$52B5,$4294,$72F7,$62D6,
  70.      $9339,$8318,$B37B,$A35A,$D3BD,$C39C,$F3FF,$E3DE,
  71.      $2462,$3443,$0420,$1401,$64E6,$74C7,$44A4,$5485,
  72.      $A56A,$B54B,$8528,$9509,$E5EE,$F5CF,$C5AC,$D58D,
  73.      $3653,$2672,$1611,$0630,$76D7,$66F6,$5695,$46B4,
  74.      $B75B,$A77A,$9719,$8738,$F7DF,$E7FE,$D79D,$C7BC,
  75.      $48C4,$58E5,$6886,$78A7,$0840,$1861,$2802,$3823,
  76.      $C9CC,$D9ED,$E98E,$F9AF,$8948,$9969,$A90A,$B92B,
  77.      $5AF5,$4AD4,$7AB7,$6A96,$1A71,$0A50,$3A33,$2A12,
  78.      $DBFD,$CBDC,$FBBF,$EB9E,$9B79,$8B58,$BB3B,$AB1A,
  79.      $6CA6,$7C87,$4CE4,$5CC5,$2C22,$3C03,$0C60,$1C41,
  80.      $EDAE,$FD8F,$CDEC,$DDCD,$AD2A,$BD0B,$8D68,$9D49,
  81.      $7E97,$6EB6,$5ED5,$4EF4,$3E13,$2E32,$1E51,$0E70,
  82.      $FF9F,$EFBE,$DFDD,$CFFC,$BF1B,$AF3A,$9F59,$8F78,
  83.      $9188,$81A9,$B1CA,$A1EB,$D10C,$C12D,$F14E,$E16F,
  84.      $1080,$00A1,$30C2,$20E3,$5004,$4025,$7046,$6067,
  85.      $83B9,$9398,$A3FB,$B3DA,$C33D,$D31C,$E37F,$F35E,
  86.      $02B1,$1290,$22F3,$32D2,$4235,$5214,$6277,$7256,
  87.      $B5EA,$A5CB,$95A8,$8589,$F56E,$E54F,$D52C,$C50D,
  88.      $34E2,$24C3,$14A0,$0481,$7466,$6447,$5424,$4405,
  89.      $A7DB,$B7FA,$8799,$97B8,$E75F,$F77E,$C71D,$D73C,
  90.      $26D3,$36F2,$0691,$16B0,$6657,$7676,$4615,$5634,
  91.      $D94C,$C96D,$F90E,$E92F,$99C8,$89E9,$B98A,$A9AB,
  92.      $5844,$4865,$7806,$6827,$18C0,$08E1,$3882,$28A3,
  93.      $CB7D,$DB5C,$EB3F,$FB1E,$8BF9,$9BD8,$ABBB,$BB9A,
  94.      $4A75,$5A54,$6A37,$7A16,$0AF1,$1AD0,$2AB3,$3A92,
  95.      $FD2E,$ED0F,$DD6C,$CD4D,$BDAA,$AD8B,$9DE8,$8DC9,
  96.      $7C26,$6C07,$5C64,$4C45,$3CA2,$2C83,$1CE0,$0CC1,
  97.      $EF1F,$FF3E,$CF5D,$DF7C,$AF9B,$BFBA,$8FD9,$9FF8,
  98.      $6E17,$7E36,$4E55,$5E74,$2E93,$3EB2,$0ED1,$1EF0);
  99.  
  100. Function CRCResult(Var Table, Buffer; CrcVal, count : integer) : integer;
  101. var temp : integer;
  102. begin
  103. Inline(
  104.  {For I := 1 to Full do
  105.    CRCval := Crctab[hi(CRCval) xor Buff^[I]] xor (lo(CRCval) shl 8);}
  106.   $1E/             {   push ds              ;save ds}
  107.   $06/             {   push es              ;save es}
  108.   $C5/$B6/>TABLE/  {   lds si, [bp+>Table]  ;ds:si points to the table}
  109.   $C4/$BE/>BUFFER/ {   les di, [bp+>buffer] ;es:si points to the buffer}
  110.   $8B/$8E/>COUNT/  {   mov cx,[bp+>count]   ;cx has the buffer size}
  111.   $8B/$9E/>CRCVAL/ {   mov bx,[bp+>CRCVal]  ;bx = start CRC value}
  112.   $E3/$25/         {   jcxz Done}
  113.   $89/$D8/         {   mov ax,bx            ;ax = start CRC value}
  114.                    { LooPit:}
  115.   $86/$C4/         {   xchg ah,al           ;al = hi byte}
  116.   $30/$E4/         {   xor ah,ah            ;ax = hi(CRCVal)}
  117.   $31/$D2/         {   xor dx,dx            ;dx = 0}
  118.   $26/             {   es:}
  119.   $8A/$15/         {   mov dl,[di]          ;dx = buffer[i] A BYTE value!!}
  120.   $47/             {   inc di               ;bump di (inc(i))}
  121.   $31/$D0/         {   xor ax,dx            ;ax = hi(CRCVal) xor Buffer[i]}
  122.   $89/$DA/         {   mov dx,bx            ;dx = CRCVal}
  123.   $89/$C3/         {   mov bx,ax            ;bx = hi(CRCVal) xor Buffer[i]}
  124.   $30/$F6/         {   xor dh,dh            ;dx = lo(CRCVal)}
  125.   $51/             {   push cx              ;save counter}
  126.   $B1/$08/         {   mov cl,8             ;need 8 shifts}
  127.   $D3/$E2/         {   shl dx,cl            ;dx = lo(CRCVal) shl 8}
  128.   $59/             {   pop cx               ;restore the counter}
  129.   $D1/$E3/         {   shl bx,1             ;need to mult by 2}
  130.   $3E/             {   ds:}
  131.   $8B/$00/         {   mov ax,[bx+si] ;ax = CRCTAbl[hi(CRCVal xor Buffer[i]]}
  132.   $31/$D0/         {   xor ax,dx      ;ax = CRCTab[hi(CRCVal) xor Buffer[i]]}
  133.                    {                        ;     xor (lo(CRCVal) shl 8)}
  134.   $89/$C3/         {   mov bx,ax            ;bx = new CRCVal}
  135.   $E2/$DD/         {   loop loopit          ;go do it all again}
  136.                    { Done:}
  137.   $89/$9E/>TEMP/   {   mov [bp+>temp],bx    ;bx has the final CRC value}
  138.   $07/             {   pop es               ;restore es}
  139.   $1F);            {   pop ds               ;restore ds}
  140.   CRCResult := temp{                        ;pass it back}
  141. end; {CrcResult}
  142.  
  143. Function CrcCalc(FileName : String) : word;
  144.   var
  145.     FI     : File;
  146.     Full   : word;        {How full is the buffer on a block read?}
  147.     CRCval : Integer;
  148.     FileAttr: word;
  149.  
  150.   begin  {CrcCalc}
  151.     New(Buff);
  152.     CrcVal := 0;
  153.     Assign(FI, FileName);
  154.     GetFAttr(FI, FileAttr);
  155.     SetFAttr(FI, 0);     {can now open any file}
  156.     Reset(FI, 1);
  157.     repeat
  158.       BlockRead(FI, Buff^, BuffSize, Full);
  159.       CrcVal := CrcResult(CrcTab, Buff^, CrcVal, Full);
  160.       until Full <= 0;
  161.     Close(FI);
  162.     SetFAttr(FI, FileAttr);    {restore original filemode}
  163.     CrcCalc := CRCval;
  164.     Dispose(Buff);
  165.     end; {CrcCalc}
  166.  
  167. Function CrcCopy(InFileName, OutFileName : String) : word;
  168. {
  169.       Calculates the CCITT asynch CRC16 value for file=InFileName. If
  170. OutFileName is specified, InFileName is copied to OutFileName. In either
  171. case, the CRC16 value is returned. The DateTime stamp of the input file
  172. is preserved.
  173. }
  174.  
  175.   var
  176.     FI,
  177.     FO     : File;
  178.     Full   : word;        {Number of bytes transferred in BlockRead}
  179.     T1     : Integer;
  180.     CRCval : Integer;
  181.     DTStamp: LongInt;
  182.     FileAttr: word;
  183.  
  184.   begin  {CrcCopy}
  185.     New(Buff);
  186.     CrcVal := 0;
  187.     Assign(FI, InFileName);
  188.     GetFattr(FI, FileAttr);
  189.     SetFAttr(FI, 0);     {can now open any file}
  190.     Reset(FI, 1);
  191.     If OutFileName[0] > #0 then begin
  192.       Assign(FO, OutFileName);
  193.       {$I-}Rewrite(FO, 1);{$I+}
  194.       If IOresult <> 0 then begin
  195.         WriteLn;
  196.         WriteLn('Can''t open file ',OutFileName,'  Aborting...');
  197.         Halt(1);
  198.         end;
  199.       end;
  200.     repeat
  201.       BlockRead(FI, Buff^, BuffSize, Full);
  202.       CrcVal := CrcResult(CrcTab, Buff^, CrcVal, Full);
  203.       If (OutFileName[0] > #0) and (Full > 0) then
  204.         {$I-}BlockWrite(FO, Buff^, Full);{$I+}
  205.       T1 := IOresult;
  206.       If T1 <> 0 then begin
  207.         WriteLn;
  208.         WriteLn('I/O error ',T1,' writing file. Aborting...');
  209.         Close(FO);
  210.         Erase(FO);
  211.         Halt(1);
  212.         end;
  213.       until Full <= 0;
  214.     GetFTime(FI, DTstamp);
  215.     Close(FI);
  216.     SetFAttr(FI, FileAttr);    {restore original filemode}
  217.     If OutFileName[0] > #0 then begin
  218.       SetFTime(FO, DTstamp);
  219.       Close(FO);
  220.       end;
  221.     CrcCopy := CRCval;
  222.     Dispose(Buff);
  223.     end; {CrcCopy}
  224.   end.
  225.